We model a decision impact pathway is for school gardens as a general intervention for sustainable children’s food environments in urban Hanoi, Vietnam (Whitney et al. 2024).

Conceptual model of school gardens as an intervention. Should urban Hanoi school boards invest time and money in creating school gardens? Should they invest in formal STEM education as part of these gardens?

Urban Hanoi school garden

Simulation of the school garden intervention options:

# Source our model
source("Garden_Model.R")

# Ensure consistent results with the random number generator
# not for each 'run' of the MC simulation but for 
# consistency each time we run the entire simulation 
set.seed(42)

garden_simulation_results <- mcSimulation(
  estimate = estimate_read_csv("data/inputs_school_garden.csv"),
  model_function = school_garden_function,
  numberOfModelRuns = 1e4, #run 10,000 times
  functionSyntax = "plainNames"
)

The Net Present Value (i.e. current value of the future benefits) of the garden decision options over 5 years of the intervention. For public and private schools the STEM costs are considered to be in the same garden space but with the additional costs and benefits of a full STEM education program. All options are compared to the same years of using the land for something that is not related to the garden, i.e. as a playground or for parking. Here we plot the distribution for the decision and frame the projected NPV.

For public schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_public_school_inclusive", 
                                             "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV public school passive garden", "NPV public school STEM garden"),
                                    method = 'smooth_simple_overlay', 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

For private schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   new_names = c("NPV private school passive garden","NPV private school STEM garden"),
                                    method = 'smooth_simple_overlay', 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

The same results again but this time as boxplots:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                   vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV private school passive garden","NPV private school STEM garden", "NPV public school passive garden", "NPV public school STEM garden"),
                                    method = "boxplot", 
                                    base_size = 11, 
                                    x_axis_name = "Comparative NPV outcomes (million VND)")

ggsave("figures/Fig_5_Boxplots.png", width = 15, height = 8, units = "cm")

As boxplots and distributions for public schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
                   new_names = c("NPV public school garden", "NPV public school garden with STEM"),
                                    method = "boxplot_density", 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

As boxplots and distributions for private schools:

source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results, 
                                    vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
                   new_names = c("NPV private school garden","NPV private school with STEM"),
                                    method = "boxplot_density", 
                                    base_size = 7, 
                                    x_axis_name = "Comparative NPV outcomes")

Summary of results for the decision

Summary of the NPVs for the passive education garden and STEM options for private schools:

summary(garden_simulation_results$y[1:2]) #"NPV_garden_inclusive"                    "NPV_garden_STEM_inclusive"
##  NPV_garden_inclusive NPV_garden_STEM_inclusive
##  Min.   : -693.6      Min.   :-2993.6          
##  1st Qu.:  677.1      1st Qu.:  164.0          
##  Median : 1333.1      Median :  835.1          
##  Mean   : 1605.4      Mean   : 1048.1          
##  3rd Qu.: 2264.3      3rd Qu.: 1730.0          
##  Max.   :11540.9      Max.   :10653.8

Summary of the NPVs for the passive education garden and STEM options for public schools:

summary(garden_simulation_results$y[3:4]) #"NPV_garden_public_school_inclusive"      "NPV_garden_STEM_public_school_inclusive"
##  NPV_garden_public_school_inclusive NPV_garden_STEM_public_school_inclusive
##  Min.   : -693.6                    Min.   :-2993.6                        
##  1st Qu.: -218.7                    1st Qu.: -268.9                        
##  Median :  510.8                    Median : -138.5                        
##  Mean   :  884.4                    Mean   :  401.9                        
##  3rd Qu.: 1577.3                    3rd Qu.:  870.5                        
##  Max.   :11540.9                    Max.   :10653.8

Summary of the child health outcomes for private and public schools:

summary(garden_simulation_results$y[10:11]) #"health" "health_STEM" 
##      health        health_STEM    
##  Min.   :   0.0   Min.   :   0.0  
##  1st Qu.: 293.2   1st Qu.: 272.7  
##  Median : 697.2   Median : 593.7  
##  Mean   : 762.9   Mean   : 605.2  
##  3rd Qu.:1116.2   3rd Qu.: 883.1  
##  Max.   :5135.4   Max.   :3156.9

Summary of the biodiversity outcomes for the passive education garden and STEM options for private and public schools:

summary(garden_simulation_results$y[9]) #"biodiversity"
##   biodiversity    
##  Min.   : 0.0000  
##  1st Qu.: 0.4342  
##  Median : 3.1548  
##  Mean   : 4.6461  
##  3rd Qu.: 7.0055  
##  Max.   :52.7607

Summary of costs

Total expected costs for a school garden with and without STEM education:

summary(garden_simulation_results$y[12:13])
##   total_costs     total_costs_STEM
##  Min.   : 91.09   Min.   : 146.0  
##  1st Qu.:198.37   1st Qu.: 360.1  
##  Median :447.99   Median : 869.7  
##  Mean   :395.30   Mean   : 939.0  
##  3rd Qu.:531.17   3rd Qu.:1276.9  
##  Max.   :937.99   Max.   :4837.2

First year expected costs for a school garden:

summary(garden_simulation_results$y$Cashflow_garden1)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -347.316 -103.374   -2.415   58.406  162.782 2046.120

First year expected costs for a school garden with STEM education:

summary(garden_simulation_results$y$Cashflow_garden_STEM1)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1095.15  -244.78  -136.34   -88.06    30.08  1973.99

Cash flows

Cash flow plots of the garden option without formal STEM education. These are the expected returns for public and private schools over the intervention.

# Cashflow of the garden option without formal STEM education
# This will be the cost for public and private schools over the intervention. 

source("functions/plot_cashflow.R")
plot_cashflow_garden <- plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden", 
              facet_labels = "Passive garden") + 
  theme(legend.position = "none", axis.title.y = element_blank(),
        axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank())  

# Cashflow of the garden option with formal STEM education
source("functions/plot_cashflow.R")
plot_cashflow_STEM <- plot_cashflow(mcSimulation_object = garden_simulation_results, 
              cashflow_var_name = "Cashflow_garden_STEM", 
              facet_labels = "STEM garden")+
  labs(y = "Cashflow (million VND)") 

# # manually share axis label (not a feature of patchwork)
# 
# ylab <- plot_cashflow_garden$labels$y
# plot_cashflow_garden$labels$y <- plot_cashflow_STEM$labels$y <- " "
# 
# h_patch <- plot_cashflow_garden / plot_cashflow_STEM 
# # Use the tag label as a y-axis label
# wrap_elements(h_patch) +
#   labs(tag = "Cashflow") +
#   theme(
#     plot.tag = element_text(size = rel(1), angle = 90),
#     plot.tag.position = "left"
#   )

plot_cashflow_garden / plot_cashflow_STEM

ggsave("figures/Fig_6_cashflow.png", width=5, height=5) 

Projection to Latent Structures (PLS)

We use Projection to Latent Structures (PLS) model to assess the correlation strength and direction for model variables and outcome variables. The Partial Least Squares is fitted with the orthogonal scores algorithm with pls::plsr.

PLS for private schools:

# For passive education garden option
source("functions/pls_model.R")
pls_result <- pls_model(object = garden_simulation_results,
                resultName = names(garden_simulation_results$y)[1], # the "NPV_garden_inclusive" 
                                ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")

label_private_school <- "Private school"

# source the plot function
source("functions/plot_pls.R")

plot_pls_garden <- plot_pls(plsrResults = pls_result, 
                            input_table = input_table, 
                            threshold = 0.9) + 
  theme(legend.position = "none", axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank()) + scale_x_continuous(limits = c(0, 7)) + ggtitle(label_private_school) + 
  annotate(geom="text", x=5, y=1, label="Passive garden")

#For school garden with formal STEM education
pls_result_STEM <- pls_model(object = garden_simulation_results,
                  resultName = names(garden_simulation_results$y)[2], # the "NPV_garden_STEM" 
                                ncomp = 1)

plot_pls_STEM <- plot_pls(plsrResults = pls_result_STEM, 
                          input_table = input_table, 
                          threshold = 0.9) + 
  scale_x_continuous(limits = c(0, 7)) + 
  annotate(geom="text", x=5, y=1, label="STEM garden")

plot_pls_garden / plot_pls_STEM 

Interpretation of PLS results for private schools

Garden options for private schools:

source("functions/pls_posthoc.R")
pls_posthoc(plsrResults = pls_result, threshold = 0.9)
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.198
## y   81.087
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.198
## y   81.087
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.198
## y   81.087
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## if_garden_yield_enough                               if_garden_yield_enough
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                             VIP Coefficient
## if_community_likes                    3.5842837    447.0804
## if_garden_yield_enough                0.9928668    123.8438
## garden_mental_health_value            2.0635014    257.3878
## child_garden_health_care_savings      3.2053872    399.8193
## child_garden_school_performance_value 0.9554562    119.1774
## school_event_value                    6.4862842    809.0572
## school_event_freq                     3.3707142    420.4411
## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## if_garden_yield_enough                               if_garden_yield_enough
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                             VIP Coefficient
## if_community_likes                    3.5842837    447.0804
## if_garden_yield_enough                0.9928668    123.8438
## garden_mental_health_value            2.0635014    257.3878
## child_garden_health_care_savings      3.2053872    399.8193
## child_garden_school_performance_value 0.9554562    119.1774
## school_event_value                    6.4862842    809.0572
## school_event_freq                     3.3707142    420.4411

STEM options for private schools:

pls_posthoc(plsrResults = pls_result_STEM, threshold = 0.9)
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.205
## y   74.335
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.205
## y   74.335
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.205
## y   74.335
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                            VIP Coefficient
## if_community_likes                    3.579643    444.4418
## annual_teacher_training               2.748437   -341.2408
## garden_mental_health_value            1.964477    243.9058
## child_STEM_community_engagement_value 1.500982    186.3592
## school_event_value                    6.564693    815.0599
## school_event_freq                     3.343556    415.1296
## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
##                                            VIP Coefficient
## if_community_likes                    3.579643    444.4418
## annual_teacher_training               2.748437   -341.2408
## garden_mental_health_value            1.964477    243.9058
## child_STEM_community_engagement_value 1.500982    186.3592
## school_event_value                    6.564693    815.0599
## school_event_freq                     3.343556    415.1296

PLS for public schools:

# For passive education garden option
source("functions/pls_model.R")

pls_result_garden_public <- pls_model(object = garden_simulation_results,
                resultName = names(garden_simulation_results$y)[3], 
                # "NPV_garden_public_school" 
                                ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")

label_public_school <- "Public school"

# source the plot function
source("functions/plot_pls.R")
plot_pls_garden_public <- plot_pls(pls_result_garden_public, 
                            input_table = input_table, threshold = 0.9) +
  theme(legend.position = "none", axis.title.x = element_blank(), 
  axis.text.x = element_blank(),
  axis.ticks = element_blank()) + 
  scale_x_continuous(limits = c(0, 7)) + ggtitle(label_public_school) + 
  annotate(geom="text", x=5, y=1, label="Passive garden")

#For school garden with formal STEM education
pls_result_STEM_public <- pls_model(object = garden_simulation_results,
                  resultName = names(garden_simulation_results$y)[4], 
                  # "NPV_garden_STEM_public_school"
                                ncomp = 1)

plot_pls_public_STEM <- plot_pls(pls_result_STEM_public, 
                                 input_table = input_table, threshold = 0.9) + scale_x_continuous(limits = c(0, 7)) + 
  annotate(geom="text", x=5, y=1, label="STEM garden")

plot_pls_garden_public / plot_pls_public_STEM 

Interpretation of PLS results for public schools

Garden option in public school:

pls_posthoc(plsrResults = pls_result_garden_public, threshold = 0.9)
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.213
## y   36.854
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.213
## y   36.854
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.213
## y   36.854
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                             VIP Coefficient
## if_community_likes                    3.4945244   302.88024
## garden_mental_health_value            2.1018058   182.16941
## child_garden_health_care_savings      3.0274769   262.39992
## child_garden_school_performance_value 0.9813592    85.05716
## school_event_value                    5.9943910   519.55069
## school_event_freq                     2.9867643   258.87125
## suitability_of_land_for_garden        1.7553215   152.13864
## beurocratic_barriers                  2.5546418  -221.41797
## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## garden_mental_health_value                       garden_mental_health_value
## child_garden_health_care_savings           child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                             VIP Coefficient
## if_community_likes                    3.4945244   302.88024
## garden_mental_health_value            2.1018058   182.16941
## child_garden_health_care_savings      3.0274769   262.39992
## child_garden_school_performance_value 0.9813592    85.05716
## school_event_value                    5.9943910   519.55069
## school_event_freq                     2.9867643   258.87125
## suitability_of_land_for_garden        1.7553215   152.13864
## beurocratic_barriers                  2.5546418  -221.41797

STEM option in public school:

pls_posthoc(plsrResults = pls_result_STEM_public, threshold = 0.9)
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.209
## y   46.197
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.209
## y   46.197
## Data:    X dimension: 10000 85 
##  Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
##    1 comps
## X    1.209
## y   46.197
## PLS Model Summary:
## Number of Components: 1 
## R-squared Value for Y: 
## % Variance Explained in X: 
## % Variance Explained in Y: 
## 
## Important Variables (VIP > 0.9):
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                             VIP Coefficient
## if_community_likes                    3.5258175   298.40772
## annual_teacher_training               3.4643766  -293.20767
## garden_mental_health_value            1.9841407   167.92784
## child_STEM_community_engagement_value 1.3770869   116.54981
## school_event_value                    6.2015333   524.86705
## school_event_freq                     3.0652792   259.43004
## suitability_of_land_for_garden        0.9652043    81.69011
## beurocratic_barriers                  1.5621160  -132.20976
## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
## 
## $r_squared
## NULL
## 
## $explained_variance_x
## NULL
## 
## $explained_variance_y
## NULL
## 
## $important_vars
##                                                                    Variable
## if_community_likes                                       if_community_likes
## annual_teacher_training                             annual_teacher_training
## garden_mental_health_value                       garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value                                       school_event_value
## school_event_freq                                         school_event_freq
## suitability_of_land_for_garden               suitability_of_land_for_garden
## beurocratic_barriers                                   beurocratic_barriers
##                                             VIP Coefficient
## if_community_likes                    3.5258175   298.40772
## annual_teacher_training               3.4643766  -293.20767
## garden_mental_health_value            1.9841407   167.92784
## child_STEM_community_engagement_value 1.3770869   116.54981
## school_event_value                    6.2015333   524.86705
## school_event_freq                     3.0652792   259.43004
## suitability_of_land_for_garden        0.9652043    81.69011
## beurocratic_barriers                  1.5621160  -132.20976

Value of Information

Here we assess value of information with the multi_EVPI function. We calculate value of information in the form of Expected Value of Perfect Information (EVPI).

# Subset the outputs from the mcSimulation function (y) by selecting the correct variables be sure to run the multi_EVPI only on the variables that we want. Find them with names(garden_simulation_results$y)
mcSimulation_table <- data.frame(garden_simulation_results$x, 
                                 garden_simulation_results$y[1:4])

# List of NPV variables to move to the last position (calculate 4 EVPIs only)
npvs_to_move <- c("NPV_garden_inclusive", "NPV_garden_STEM_inclusive", 
                  "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive")

# Move NPV variables to the last position
mcSimulation_table <- mcSimulation_table %>% select(-all_of(npvs_to_move), all_of(npvs_to_move))

Calculate EVPI:

# source("functions/multi_EVPI_test.R")
# evpi <- multi_EVPI_test(mc = mcSimulation_table, first_out_var = "NPV_garden_inclusive")
#  # save as a local .csv (takes ~ 15 minutes to run this)
# save(evpi,file="data/data_evpi.Rda")
 load("data/data_evpi.Rda")
# open from saved file (last model run) - it is stable result / takes very long to run 

EVPI for private schools:

#Value of information the garden intervention decision
  source("functions/plot_evpi.R")
# plot_evpi_garden <- plot_evpi(EVPIresults = evpi,
#                             decision_vars = "NPV_garden_inclusive",
#                             new_names = "Garden",
#                           input_table = input_table,
#                           threshold = 10) +
# theme(legend.position = "none", axis.title.x = element_blank(),
# axis.text.x = element_blank(),
# axis.ticks = element_blank()) +
# scale_x_continuous(limits = c(0, 210))
# Value of information for the garden option with formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_STEM <- plot_evpi(EVPIresults = evpi,
#                             decision_vars = "NPV_garden_STEM_inclusive",
#                             new_names = "STEM garden pivate school",
#                             input_table = input_table,
#                             threshold = 10) + scale_x_continuous(limits = c(0, 30)) # + ggtitle(label_private_school)
# plot_evpi_garden / plot_evpi_STEM

EVPI for public schools:

# Value of information for the public school garden option with no formal STEM education.

# using the results of the same multi_EVPI
# plot_evpi_public <- plot_evpi(evpi, decision_vars = "NPV_garden_public_school_inclusive",
#                             new_names = "Garden",
#                             input_table = input_table,
#                             threshold = 10) +
#   theme(legend.position = "none", axis.title.x = element_blank(),
#   axis.text.x = element_blank(),
#   axis.ticks = element_blank())  +
#   scale_x_continuous(limits = c(0, 30))
# Value of information for the public school garden option with formal STEM education.
# using the results of the same multi_EVPI
plot_evpi_public_STEM <- plot_evpi(evpi, decision_vars = "NPV_garden_STEM_public_school_inclusive", 
                            new_names = "STEM garden public school",
                            input_table = input_table, 
                            threshold = 10)  + 
  scale_x_continuous(limits = c(0, 30)) # + ggtitle(label_public_school)
plot_evpi_public_STEM

Pareto-optimal solutions

Our Pareto-optimal solutions represent the best trade-offs among the objectives of biodiversity, child health, and economic return. By focusing on these Pareto-optimal points, the analysis highlights solutions where improvements in one objective cannot be achieved without some compromise in at least one other.

source("pareto/plot_pareto_scenarios.R")

final_plot

# Save the plot
ggsave("figures/Fig_8_pareto_fronts.png", final_plot, width = 10, height = 8, bg = "white")

Controllable variables included:

estimates = read.csv("data/inputs_school_garden.csv")
estimates = estimates[estimates$variable !="", ]

estimates[estimates$control_status == "controllable", ]
##                 variable lower median upper distribution
## 6         size_of_garden   5.0     NA 100.0      posnorm
## 21  if_animals_in_garden   0.2     NA   0.8    tnorm_0_1
## 54 if_school_has_canteen   0.2     NA   0.5    tnorm_0_1
## 94     school_event_freq   3.0     NA  10.0      posnorm
## 98            if_parking   0.1     NA   0.8    tnorm_0_1
##                                                           label control_status
## 6                                 Size of school garden in (m2)   controllable
## 21 Chance of school choosing to integrate animals in garden (%)   controllable
## 54                     Chance that the school has a canteen (%)   controllable
## 94                 Number of school events per year (days/year)   controllable
## 98 Chance of including parking on the plot without a garden (%)   controllable

Variables that are considered out of the control of the decision maker included:

estimates[estimates$control_status != "controllable", ]
##                                    variable  lower median  upper distribution
## 1                           number_of_years  5.000     NA   5.00        const
## 2                             discount_rate  3.000     NA   8.00      posnorm
## 3                                  CV_value  0.100     NA   0.40    tnorm_0_1
## 4                            inflation_rate  5.000     NA  10.00      posnorm
## 8                          if_students_like  0.500     NA   0.80    tnorm_0_1
## 9                           if_parents_like  0.500     NA   0.90    tnorm_0_1
## 10                       if_community_likes  0.100     NA   0.85    tnorm_0_1
## 11                      if_effective_manage  0.500     NA   0.70    tnorm_0_1
## 12                   if_garden_yield_enough  0.300     NA   0.80    tnorm_0_1
## 13                        if_garden_healthy  0.500     NA   0.90    tnorm_0_1
## 14                         if_teachers_like  0.200     NA   0.90    tnorm_0_1
## 15                    if_effective_teaching  0.200     NA   0.90    tnorm_0_1
## 16                    if_effective_training  0.200     NA   0.80    tnorm_0_1
## 17                     if_offer_green_space  0.500     NA   0.90    tnorm_0_1
## 18                      if_reduce_pollution  0.200     NA   0.50    tnorm_0_1
## 19                      if_biophysical_good  0.200     NA   0.80    tnorm_0_1
## 22            livestock_establishment_costs  5.000     NA  25.00      posnorm
## 23                            fishpond_cost  7.000     NA  10.00      posnorm
## 24                      manure_yield_effect  0.010     NA   0.10      posnorm
## 25           livestock_mental_health_effect  0.010     NA   0.10      posnorm
## 27                           equipment_cost  6.000     NA  20.00      posnorm
## 28                        construction_cost  6.500     NA 130.50      posnorm
## 29                   garden_designing_costs 10.000     NA  15.00      posnorm
## 30                    teacher_training_cost  5.000     NA  20.00      posnorm
## 31                    school_board_planning  6.000     NA  12.00      posnorm
## 32                       teaching_equipment  5.000     NA  10.00      posnorm
## 33                         compost_starting  5.000     NA  10.00      posnorm
## 34                            worm_starting  3.000     NA  10.00      posnorm
## 36             if_family_pays_establishment  0.200     NA   0.50    tnorm_0_1
## 37        establishment_family_portion_paid  0.200     NA   0.80    tnorm_0_1
## 39                        maintaining_labor 25.000     NA  40.00      posnorm
## 40                     maintaining_labor_m2  0.250     NA   0.40      posnorm
## 41                      teacher_salary_cost 20.000     NA  30.00      posnorm
## 42                teaching_equipment_annual  1.000     NA  40.00      posnorm
## 43                           teaching_tools  2.000     NA  10.00      posnorm
## 44                               seed_costs  5.000     NA  20.00      posnorm
## 45                            seed_costs_m2  0.050     NA   0.20      posnorm
## 46                               fertilizer  1.000     NA   2.00      posnorm
## 47                            fertilizer_m2  0.010     NA   0.02      posnorm
## 48                         plant_protection  2.000     NA   5.00      posnorm
## 49                      plant_protection_m2  0.020     NA   0.05      posnorm
## 50                          livestock_maint  2.000     NA  10.00      posnorm
## 51                       livestock_maint_m2  0.020     NA   0.10      posnorm
## 52                  annual_teacher_training  5.000     NA 276.00      posnorm
## 55                          canteen_savings  1.000     NA   5.00      posnorm
## 56                       canteen_savings_m2  0.010     NA   0.05      posnorm
## 57                            sale_of_yield 10.000     NA  30.00      posnorm
## 58                         sale_of_yield_m2  0.100     NA   0.30      posnorm
## 59                 extra_cirricular_savings 20.000     NA 100.00      posnorm
## 60                       formal_edu_savings  1.000     NA   3.00      posnorm
## 61                  formal_edu_savings_STEM 20.000     NA 100.00      posnorm
## 63                 outside_investment_value  1.000     NA   5.00      posnorm
## 64            outside_investment_value_STEM  1.000     NA   8.00      posnorm
## 66               increased_enrollment_value  0.100     NA   5.00      posnorm
## 67          increased_enrollment_value_STEM 10.000     NA 100.00      posnorm
## 69            child_veg_health_care_savings  0.100     NA   5.00      posnorm
## 70       child_veg_school_performance_value  0.010     NA   0.20      posnorm
## 71     child_veg_community_engagement_value  0.010     NA   0.10      posnorm
## 73               garden_mental_health_value  4.000     NA 300.00      posnorm
## 75         child_garden_health_care_savings  9.000     NA 500.00      posnorm
## 76    child_garden_school_performance_value 21.000     NA 182.00      posnorm
## 77  child_garden_community_engagement_value  3.000     NA   7.00      posnorm
## 79           child_STEM_health_care_savings 20.000     NA  80.00      posnorm
## 80      child_STEM_school_performance_value  2.000     NA 100.00      posnorm
## 81    child_STEM_community_engagement_value 10.000     NA 250.00      posnorm
## 83                    green_space_eco_value  1.000     NA  10.00      posnorm
## 84                 green_space_eco_value_m2  0.010     NA   0.10      posnorm
## 85                   reduce_pollution_value  1.000     NA   3.00      posnorm
## 86                reduce_pollution_value_m2  0.010     NA   0.03      posnorm
## 88      chance_garden_is_fallow_green_space  0.001     NA   0.05    tnorm_0_1
## 89                     fallow_eco_reduction  0.500     NA   0.80    tnorm_0_1
## 90                 green_space_health_value  1.000     NA  10.00      posnorm
## 91                  fallow_health_reduction  0.500     NA   0.80    tnorm_0_1
## 93                       school_event_value 10.000     NA 200.00      posnorm
## 95                   school_event_mgmt_cost  0.500     NA  10.00      posnorm
## 97             value_of_non_garden_land_use 20.000     NA  50.00      posnorm
## 99                            parking_value  0.100     NA   3.00      posnorm
## 100            costs_of_non_garden_land_use  1.000     NA   5.00      posnorm
## 102                             land_access  0.600     NA   0.95    tnorm_0_1
## 103          suitability_of_land_for_garden  0.600     NA   0.95    tnorm_0_1
## 104                    beurocratic_barriers  0.010     NA   0.50    tnorm_0_1
##                                                                                              label
## 1                                                            Number of years for garden simulation
## 2                                                                               Discounting factor
## 3                                  Coefficient of variation for our school garden intervention (%)
## 4                                                                               Inflation rate (%)
## 8                                                                 Chance of student engagement (%)
## 9                                                    Chance of parents support / effectiveness (%)
## 10                                                                 Chance of community support (%)
## 11                                                       Chance of effective garden management (%)
## 12                                                      Chance of sufficient yield from garden (%)
## 13                                                          Chance of healthy food from garden (%)
## 14                                                                Chance of teacher engagement (%)
## 15                                            Chance of high education quality / effectiveness (%)
## 16                                                   Chance of effective training for teachers (%)
## 17                                   Chance of garden having ecologically valuable green space (%)
## 18                                                          Chance of garden reducing polution (%)
## 19                                           Chance of biophysical not damaging (i.e. weather) (%)
## 22                                                   Starting animals  in the garden (million VND)
## 23                                                 Digging a fish pond in the garden (million VND)
## 24                                                            Effect of manure on garden yield (%)
## 25                                                 Effect of animals on mental health benefits (%)
## 27                                          Costs of equipment for setting up garden (million VND)
## 28                                       Costs of construction for setting up garden (million VND)
## 29                                                   Costs of design team consultant (million VND)
## 30                                 Costs of training teachers when setting up garden (million VND)
## 31                                                        Costs of planning meetings (million VND)
## 32                                                            Equipment for teaching (million VND)
## 33                                                                  Starting compost (million VND)
## 34                                                        Starting worms for compost (million VND)
## 36                                                Chance that families donate to establishment (%)
## 37                                          Portion of establishment costs donated by families (%)
## 39                          Standard annual Labor cost to maintain school garden  (million VND/yr)
## 40               Additional (per m2) annual labor cost to maintain school garden  (million VND/yr)
## 41                    Standard annual additional teacher salary costs with garden (million VND/yr)
## 42  Standard annual teaching equipment / manitaining microscopes etc. with garden (million VND/yr)
## 43                        Standard annual teaching tools / paper etc. with garden (million VND/yr)
## 44                                                            Seeds and seedlings (million VND/yr)
## 45                                        Additional (per m2) seeds and seedlings (million VND/yr)
## 46                           Standard annual fertilizer i.e. EM to add to compost (million VND/yr)
## 47                       Additional (per m2) fertilizer i.e. EM to add to compost (million VND/yr)
## 48                                              Integrated Pest Managemernt (IPM) (million VND/yr)
## 49                                              Integrated Pest Managemernt (IPM) (million VND/yr)
## 50                                  Standard annual costs of mainitaining animals (million VND/yr)
## 51                                       Additional (per m2) mainitaining animals (million VND/yr)
## 52                                                  Mainitaining teacher training (million VND/yr)
## 55                                                                Canteen savings (million VND/yr)
## 56                                                         Canteen savings per m2 (million VND/yr)
## 57                                                       Sales of garden products (million VND/yr)
## 58                                                Sales of garden products per m2 (million VND/yr)
## 59                                      Savings from extra-cirriclar activities (million VND/year)
## 60                           Savings on formal education costs (no STEM garden) (million VND/year)
## 61                                       Savings on STEM formal education costs (million VND/year)
## 63                                 Outside investment value (reputation) garden (million VND/year)
## 64                                   Outside investment value (reputation) STEM (million VND/year)
## 66                      Increased enrollment/tuition income (reputation) garden (million VND/year)
## 67                        Increased enrollment/tuition income (reputation) STEM (million VND/year)
## 69                                  Healthcare savings (child) access to garden (million VND/year)
## 70                              School performance (children) eating garden veg (million VND/year)
## 71                            Community engagement (children) eating garden veg (million VND/year)
## 73             Mental health value of children/others having a garden at school (million VND/year)
## 75                                    Healthcare savings (children) with garden (million VND/year)
## 76                              School performance value (children) with garden (million VND/year)
## 77                            Community engagement value (children) with garden (million VND/year)
## 79                                    Healthcare savings (children) STEM garden (million VND/year)
## 80                              School performance value (children) STEM garden (million VND/year)
## 81                            Community engagement value (children) STEM garden (million VND/year)
## 83                                                         Value of green space (million VND/year)
## 84                                                  Value of green space per m2 (million VND/year)
## 85                                   Value of reduced polution by school garden (million VND/year)
## 86                            Value of reduced polution by school garden per m2 (million VND/year)
## 88                                          Chance that the garden space is fallow green space (%)
## 89                                 Proportion of value of fallow greenspace compared to garden (%)
## 90                             Value of non-garden green space for child health (million VND/year)
## 91                Proportion of value of fallow greenspace for child heatlh compared to garden (%)
## 93                                       Value of garden related school events (million VND/event)
## 95                                        Cost of garden related school events (million VND/event)
## 97                                  Value of non garden land use, playground etc. (million VND/yr)
## 99                                                   Above table value of parking (million VND/yr)
## 100                                                   Cost of non garden land use (million VND/yr)
## 102                                                   Chance that the school has acess to land (%)
## 103                                             Chance that the land at the school is suitable (%)
## 104                                  Chance that beurocratic barriers will inhibit the process (%)
##     control_status
## 1        uncertain
## 2        uncertain
## 3        uncertain
## 4        uncertain
## 8        uncertain
## 9        uncertain
## 10       uncertain
## 11       uncertain
## 12       uncertain
## 13       uncertain
## 14       uncertain
## 15       uncertain
## 16       uncertain
## 17       uncertain
## 18       uncertain
## 19       uncertain
## 22       uncertain
## 23       uncertain
## 24       uncertain
## 25       uncertain
## 27       uncertain
## 28       uncertain
## 29       uncertain
## 30       uncertain
## 31       uncertain
## 32       uncertain
## 33       uncertain
## 34       uncertain
## 36       uncertain
## 37       uncertain
## 39       uncertain
## 40       uncertain
## 41       uncertain
## 42       uncertain
## 43       uncertain
## 44       uncertain
## 45       uncertain
## 46       uncertain
## 47       uncertain
## 48       uncertain
## 49       uncertain
## 50       uncertain
## 51       uncertain
## 52       uncertain
## 55       uncertain
## 56       uncertain
## 57       uncertain
## 58       uncertain
## 59       uncertain
## 60       uncertain
## 61       uncertain
## 63       uncertain
## 64       uncertain
## 66       uncertain
## 67       uncertain
## 69       uncertain
## 70       uncertain
## 71       uncertain
## 73       uncertain
## 75       uncertain
## 76       uncertain
## 77       uncertain
## 79       uncertain
## 80       uncertain
## 81       uncertain
## 83       uncertain
## 84       uncertain
## 85       uncertain
## 86       uncertain
## 88       uncertain
## 89       uncertain
## 90       uncertain
## 91       uncertain
## 93       uncertain
## 95       uncertain
## 97       uncertain
## 99       uncertain
## 100      uncertain
## 102      uncertain
## 103      uncertain
## 104      uncertain

Summarize objective results for the Pareto

An rmoo::summary of the values resulting from the rmoo::nsga2 minimization of a fitness function using non-dominated sorting genetic algorithms - II (NSGA-IIs). Multiobjective evolutionary algorithms with 2500 random draws with the decisionSupport::random, a population size of 80 and 80 iterations (or ‘generations’ maxiter) in rmoo::nsga2.

Load the results of a multi-objective optimization run with load, including the fitness values and population of solutions. Display the optimal results with rmoo::summary. The final result@fitness contains the fitness values for all solutions in the final generation of the optimization. The rmoo:non_dominated_fronts() identifies which solutions are Pareto-optimal. The sweep Filters the rescaled fitness matrix mat to retain only the Pareto-optimal solutions front1_set indices of Pareto-optimal solutions from mat2 that includes only these Pareto-optimal solutions. For example, if mat2 has 80 rows, but front1_set contains 24 indices, set1 will be a 24×3 matrix.

load(file="data/optimization_results/result_nostem_priv_new.RData")
#  loads the previously saved result object from an .RData file. The object
#  contains the results of a multi-objective optimization run, including the
#  fitness values and population of solutions.
rmoo::summary(result_nostem_priv) # displays a summary of the optimization results
## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  80
## Population size:  80
## Nondominated points found:  80 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================
mat = result_nostem_priv@fitness 
# contains the fitness values for all solutions in the final 
# generation of the optimization
front1_set = rmoo::non_dominated_fronts(result_nostem_priv)$fit[[1]]
# rmoo:non_dominated_fronts()  to identify which solutions are Pareto-optimal
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
# Filters the rescaled fitness matrix (mat2) to retain only the Pareto-optimal solutions.

# front1_set= indices of Pareto-optimal solutions from mat2 that includes only
# these Pareto-optimal solutions. Example: If mat2 has 200 rows, but front1_set
# contains 24 indices, set1 will be a 24 × 3 24×3 matrix.
set1 = mat2[front1_set, ]

# Repeat for other options
load(file="data/optimization_results/result_stem_priv_new.RData")
rmoo::summary(result_stem_priv)
## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  80
## Population size:  80
## Nondominated points found:  80 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================
mat = result_stem_priv@fitness
front1_set = rmoo::non_dominated_fronts(result_stem_priv)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set2_1 = mat2[front1_set, ]
set2 = set2_1[set2_1[, 1]>0, ]

load(file="data/optimization_results/result_nostem_pub_new.RData")
rmoo::summary(result_nostem_pub)
## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  80
## Population size:  80
## Nondominated points found:  80 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================
mat = result_nostem_pub@fitness
front1_set = rmoo::non_dominated_fronts(result_nostem_pub)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set3 = mat2[front1_set, ]

load(file="data/optimization_results/result_stem_pub_new.RData")
rmoo::summary(result_stem_pub)
## 
## Summary of NSGA-II run
## #====================================
## Number of Objectives evaluated:  3
## Total iterations:  80
## Population size:  80
## Nondominated points found:  80 (100% of total)
## Crowding distance bounds:  Inf 0
## Mutation Probability:  10%
## Crossover Probability:  80%
## 
## Please install package 'ecr' to calculate IGD and GD.
## 
## Please install package 'emoa' to calculate hypervolume.
## #====================================
mat = result_stem_pub@fitness
front1_set = rmoo::non_dominated_fronts(result_stem_pub)$fit[[1]]
mat2 = sweep(-mat, 2, c(100, 1, 100) , `*`) # retransform
set4 = mat2[front1_set, ]

Plot of all options

# Plot Pareto results ####

# Filter outliers
set1 <- set1[set1[, 1] > 0, ]
set2 <- set2[set2[, 1] > 0, ]
set3 <- set3[set3[, 1] > 0, ]
set4 <- set4[set4[, 1] > 0, ]

set1 <- set1[set1[, 2] > 9.6, ]
set2 <- set2[set2[, 2] > 9.6, ]
set3 <- set3[set3[, 2] > 9.6, ]
set4 <- set4[set4[, 2] > 9.6, ]

library(plotly)
library(ggplot2)
library(cowplot)

pareto_3d_plot <- plot_ly() %>%
  add_trace(x = set1[,1], y = set1[,2], z = set1[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'blue', size = 5),
            name = 'private, no STEM') %>%
  add_trace(x = set2[,1], y = set2[,2], z = set2[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'red', size = 5),
            name = 'private, STEM') %>%
  add_trace(x = set3[,1], y = set3[,2], z = set3[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'green', size = 5),
            name = 'public, no STEM') %>%
  add_trace(x = set4[,1], y = set4[,2], z = set4[,3],
            type = "scatter3d", mode = "markers",
            marker = list(color = 'orange', size = 5),
            name = 'public, STEM') %>%
  layout(scene = list(xaxis = list(title = 'economic'),
                      yaxis = list(title = 'biodiversity'),
                      zaxis = list(title = 'health')))

pareto_3d_plot

Input data for the simulations

Summary

Here we provide a summary of the garden intervention options. We do this with a summary table of the simulation results. We show the percentage of missing values as well as the mean, median and standard deviation (SD) for each output of our model simulations. We use the gt_plt_summary() from {gtExtras} and with options from {svglite}. The table shows the name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for all variables that were fed into the model from our input table of uncertainty values.

# Subset the outputs from the mcSimulation function (y) to summarize only on the variables that we want.
# names(garden_simulation_results$x)
mcSimulation_table_x <- data.frame(garden_simulation_results$x[4:7]) #, 21:30, 32:41, 43:70, 73:76)  also of possible interest

 gtExtras::gt_plt_summary(mcSimulation_table_x) 
mcSimulation_table_x
10000 rows x 4 cols
Column Plot Overview Missing Mean Median SD
inflation_rate 214 0.0% 7.5 7.5 1.5
size_of_garden 0183 0.0% 45.7 41.8 29.6
if_students_like 0.290.97 0.0% 0.6 0.6 0.1
if_parents_like 0.251.00 0.0% 0.7 0.7 0.1
# a summary table with missing, mean, median and sd

The table shows the variable name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for variables that calculated in the model.

The full repository can be accessed at https://github.com/CWWhitney/urban_school_gardens